Attribute VB_Name = "movies"
Option Explicit

Public s As String, InitDir As String, szOutputAVIFile As String, res As Long, pfile As Long, bmp As cDIB, ps As Long, psCompressed As Long, strhdr As AVI_STREAM_INFO, BI As BITMAPINFOHEADER, Opts As AVI_COMPRESS_OPTIONS, pOpts As Long, i As Long, lhwnd As Long

Public AVITemp As String
Public MoviePlaying As Boolean 'is movie playing?
Public MovieRecording As Boolean 'is movie recording?
Public MovieSlot As Integer 'current movie slot

Public AVIRecording As Boolean
Public AVIFrames As Long
Public AVIFlipper As Boolean 'for skipping frames

Public Const SRCCOPY = &HCC0020   'Copies the source over the destination

Public Declare Function mmioStringToFOURCC Lib "winmm.dll" Alias "mmioStringToFOURCCA" (ByVal sz As String, ByVal uFlags As Long) As Long 'returns fourcc
Public Declare Function VideoForWindowsVersion Lib "msvfw32.dll" () As Long
Public Declare Function AVIFileOpen Lib "avifil32.dll" (ByRef ppfile As Long, ByVal szFile As String, ByVal uMode As Long, ByVal pclsidHandler As Long) As Long  'HRESULT
Public Declare Function AVIFileInfo Lib "avifil32.dll" (ByVal pfile As Long, pfi As AVI_FILE_INFO, ByVal lSize As Long) As Long 'HRESULT
Public Declare Function AVIFileCreateStream Lib "avifil32.dll" Alias "AVIFileCreateStreamA" (ByVal pfile As Long, ByRef ppavi As Long, ByRef psi As AVI_STREAM_INFO) As Long
Public Declare Function AVISaveOptions Lib "avifil32.dll" (ByVal hWnd As Long, ByVal uiFlags As Long, ByVal nStreams As Long, ByRef ppavi As Long, ByRef ppOptions As Long) As Long
Public Declare Function AVISave Lib "avifil32.dll" Alias "AVISaveVA" (ByVal szFile As String, ByVal pclsidHandler As Long, ByVal lpfnCallback As Long, ByVal nStreams As Long, ByRef ppaviStream As Long, ByRef ppCompOptions As Long) As Long
Public Declare Function AVISaveOptionsFree Lib "avifil32.dll" (ByVal nStreams As Long, ByRef ppOptions As Long) As Long
Public Declare Function AVIMakeCompressedStream Lib "avifil32.dll" (ByRef ppsCompressed As Long, ByVal psSource As Long, ByRef lpOptions As AVI_COMPRESS_OPTIONS, ByVal pclsidHandler As Long) As Long
Public Declare Function AVIStreamSetFormat Lib "avifil32.dll" (ByVal pavi As Long, ByVal lPos As Long, ByRef lpFormat As Any, ByVal cbFormat As Long) As Long
Public Declare Function AVIStreamWrite Lib "avifil32.dll" (ByVal pavi As Long, ByVal lStart As Long, ByVal lSamples As Long, ByVal lpBuffer As Long, ByVal cbBuffer As Long, ByVal dwFlags As Long, ByRef plSampWritten As Long, ByRef plBytesWritten As Long) As Long
Public Declare Function AVIStreamReadFormat Lib "avifil32.dll" (ByVal pAVIStream As Long, ByVal lPos As Long, ByVal lpFormatBuf As Long, ByRef sizeBuf As Long) As Long
Public Declare Function AVIStreamRead Lib "avifil32.dll" (ByVal pAVIStream As Long, ByVal lStart As Long, ByVal lSamples As Long, ByVal lpBuffer As Long, ByVal cbBuffer As Long, ByRef pBytesWritten As Long, ByRef pSamplesWritten As Long) As Long
Public Declare Function AVIStreamGetFrameOpen Lib "avifil32.dll" (ByVal pAVIStream As Long, ByRef bih As Any) As Long
Public Declare Function AVIStreamGetFrame Lib "avifil32.dll" (ByVal pGetFrameObj As Long, ByVal lPos As Long) As Long
Public Declare Function AVIStreamGetFrameClose Lib "avifil32.dll" (ByVal pGetFrameObj As Long) As Long
Public Declare Function AVIFileGetStream Lib "avifil32.dll" (ByVal pfile As Long, ByRef ppaviStream As Long, ByVal fccType As Long, ByVal lParam As Long) As Long
Public Declare Function AVIMakeFileFromStreams Lib "avifil32.dll" (ByRef ppfile As Long, ByVal nStreams As Long, ByVal pAVIStreamArray As Long) As Long
Public Declare Function AVIStreamInfo Lib "avifil32.dll" (ByVal pAVIStream As Long, ByRef psi As AVI_STREAM_INFO, ByVal lSize As Long) As Long
Public Declare Function AVIStreamStart Lib "avifil32.dll" (ByVal pavi As Long) As Long
Public Declare Function AVIStreamLength Lib "avifil32.dll" (ByVal pavi As Long) As Long
Public Declare Function AVIStreamRelease Lib "avifil32.dll" (ByVal pavi As Long) As Long 'ULONG
Public Declare Function AVIStreamClose Lib "avifil32.dll" Alias "AVIStreamRelease" (ByVal pavi As Long) As Long 'ULONG
Public Declare Function AVIFileRelease Lib "avifil32.dll" (ByVal pfile As Long) As Long
Public Declare Function AVIFileClose Lib "avifil32.dll" Alias "AVIFileRelease" (ByVal pfile As Long) As Long
Public Declare Function AVIMakeStreamFromClipboard Lib "avifil32.dll" (ByVal cfFormat As Long, ByVal hGlobal As Long, ByRef ppstream As Long) As Long
Public Declare Function AVIPutFileOnClipboard Lib "avifil32.dll" (ByVal pAVIFile As Long) As Long
Public Declare Function AVIGetFromClipboard Lib "avifil32.dll" (ByRef ppAVIFile As Long) As Long
Public Declare Function AVIClearClipboard Lib "avifil32.dll" () As Long

Public Declare Sub AVIFileInit Lib "avifil32.dll" ()
Public Declare Sub AVIFileExit Lib "avifil32.dll" ()

Private Const BMP_MAGIC_COOKIE As Integer = 19778

Public Type BITMAPFILEHEADER '14 bytes
  bfType As Integer
  bfSize As Long
  bfReserved1 As Integer
  bfReserved2 As Integer
  bfOffBits As Long
End Type

Public Type BITMAPINFOHEADER_MJPEG '68 bytes
   biSize As Long
   biWidth As Long
   biHeight As Long
   biPlanes As Integer
   biBitCount As Integer
   biCompression As Long
   biSizeImage As Long
   biXPelsPerMeter As Long
   biYPelsPerMeter As Long
   biClrUsed As Long
   biClrImportant As Long
   biExtDataOffset As Long
   JPEGSize As Long
   JPEGProcess As Long
   JPEGColorSpaceID As Long
   JPEGBitsPerSample As Long
   JPEGHSubSampling As Long
   JPEGVSubSampling As Long
End Type
        
Public Type AVI_RECT
    left As Long
    top As Long
    right As Long
    bottom As Long
End Type

Public Type AVI_STREAM_INFO
    fccType As Long
    fccHandler As Long
    dwFlags As Long
    dwCaps As Long
    wPriority As Integer
    wLanguage As Integer
    dwScale As Long
    dwRate As Long
    dwStart As Long
    dwLength As Long
    dwInitialFrames As Long
    dwSuggestedBufferSize As Long
    dwQuality As Long
    dwSampleSize As Long
    rcFrame As AVI_RECT
    dwEditCount  As Long
    dwFormatChangeCount As Long
    szName As String * 64
End Type

Public Type AVI_FILE_INFO
    dwMaxBytesPerSecond As Long
    dwFlags As Long
    dwCaps As Long
    dwStreams As Long
    dwSuggestedBufferSize As Long
    dwWidth As Long
    dwHeight As Long
    dwScale As Long
    dwRate As Long
    dwLength As Long
    dwEditCount As Long
    szFileType As String * 64
End Type

Public Type AVI_COMPRESS_OPTIONS
    fccType As Long
    fccHandler As Long
    dwKeyFrameEvery As Long
    dwQuality As Long
    dwBytesPerSecond As Long
    dwFlags As Long
    lpFormat As Long
    cbFormat As Long
    lpParms As Long
    cbParms As Long
    dwInterleaveEvery As Long
End Type

Global Const AVIERR_OK As Long = 0&

Private Const SEVERITY_ERROR    As Long = &H80000000
Private Const FACILITY_ITF      As Long = &H40000
Private Const AVIERR_BASE       As Long = &H4000

Global Const AVIERR_BADFLAGS    As Long = SEVERITY_ERROR Or FACILITY_ITF Or (AVIERR_BASE + 105) '-2147205015
Global Const AVIERR_BADPARAM    As Long = SEVERITY_ERROR Or FACILITY_ITF Or (AVIERR_BASE + 106) '-2147205014
Global Const AVIERR_BADSIZE     As Long = SEVERITY_ERROR Or FACILITY_ITF Or (AVIERR_BASE + 107) '-2147205013
Global Const AVIERR_USERABORT   As Long = SEVERITY_ERROR Or FACILITY_ITF Or (AVIERR_BASE + 198) '-2147204922

Global Const AVIFILEINFO_HASINDEX         As Long = &H10
Global Const AVIFILEINFO_MUSTUSEINDEX     As Long = &H20
Global Const AVIFILEINFO_ISINTERLEAVED    As Long = &H100
Global Const AVIFILEINFO_WASCAPTUREFILE   As Long = &H10000
Global Const AVIFILEINFO_COPYRIGHTED      As Long = &H20000

Global Const AVIFILECAPS_CANREAD          As Long = &H1
Global Const AVIFILECAPS_CANWRITE         As Long = &H2
Global Const AVIFILECAPS_ALLKEYFRAMES     As Long = &H10
Global Const AVIFILECAPS_NOCOMPRESSION    As Long = &H20

Global Const AVICOMPRESSF_INTERLEAVE     As Long = &H1           '// interleave
Global Const AVICOMPRESSF_DATARATE       As Long = &H2           '// use a data rate
Global Const AVICOMPRESSF_KEYFRAMES      As Long = &H4           '// use keyframes
Global Const AVICOMPRESSF_VALID          As Long = &H8           '// has valid data?

Global Const OF_READ  As Long = &H0
Global Const OF_WRITE As Long = &H1
Global Const OF_SHARE_DENY_WRITE As Long = &H20
Global Const OF_CREATE As Long = &H1000

Global Const AVIIF_KEYFRAME  As Long = &H10

Global Const DIB_RGB_COLORS  As Long = 0    '/* color table in RGBs */
Global Const DIB_PAL_COLORS  As Long = 1    '/* color table in palette indices */

Global Const BI_RGB          As Long = 0
Global Const BI_RLE8         As Long = 1
Global Const BI_RLE4         As Long = 2
Global Const BI_BITFIELDS    As Long = 3

Global Const streamtypeVIDEO       As Long = 1935960438 'equivalent to: mmioStringToFOURCC("vids", 0&)
Global Const streamtypeAUDIO       As Long = 1935963489 'equivalent to: mmioStringToFOURCC("auds", 0&)
Global Const streamtypeMIDI        As Long = 1935960429 'equivalent to: mmioStringToFOURCC("mids", 0&)
Global Const streamtypeTEXT        As Long = 1937012852 'equivalent to: mmioStringToFOURCC("txts", 0&)

Global Const AVIGETFRAMEF_BESTDISPLAYFMT  As Long = 1

Global Const ICMF_CHOOSE_KEYFRAME           As Long = &H1     '// show KeyFrame Every box
Global Const ICMF_CHOOSE_DATARATE           As Long = &H2     '// show DataRate box
Global Const ICMF_CHOOSE_PREVIEW            As Long = &H4     '// allow expanded preview dialog
Global Const ICMF_CHOOSE_ALLCOMPRESSORS     As Long = &H8     '// don't only show those that
                                                              '// can handle the input format
Private Declare Function SetRect Lib "user32.dll" (ByRef lprc As AVI_RECT, ByVal xLeft As Long, ByVal yTop As Long, ByVal xRight As Long, ByVal yBottom As Long) As Long
Private Declare Function GetProcessHeap Lib "kernel32.dll" () As Long
Private Declare Function HeapAlloc Lib "kernel32.dll" (ByVal hHeap As Long, ByVal dwFlags As Long, ByVal dwBytes As Long) As Long
Private Declare Function HeapFree Lib "kernel32.dll" (ByVal hHeap As Long, ByVal dwFlags As Long, ByVal lpMem As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (ByRef dest As Any, ByRef src As Any, ByVal dwLen As Long)

Private Const HEAP_ZERO_MEMORY As Long = &H8

Global gfAbort As Boolean

Public Declare Function StretchBlt Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal nSrcWidth As Long, ByVal nSrcHeight As Long, ByVal dwRop As Long) As Long
Public Declare Function GetLongPathName Lib "kernel32" Alias "GetLongPathNameA" (ByVal lpszLongPath As String, ByVal lpszLongPath As String, ByVal cchBuffer As Long) As Long

Public Type BITMAPINFOHEADER '40 bytes
   biSize As Long
   biWidth As Long
   biHeight As Long
   biPlanes As Integer
   biBitCount As Integer
   biCompression As Long
   biSizeImage As Long
   biXPelsPerMeter As Long
   biYPelsPerMeter As Long
   biClrUsed As Long
   biClrImportant As Long
End Type

Public Type RGBQUAD
    Red As Byte
    Green As Byte
    Blue As Byte
    Reserved As Byte
End Type

Public Type BITMAP
    bmType As Long
    bmWidth As Long
    bmHeight As Long
    bmWidthBytes As Long
    bmPlanes As Integer
    bmBitsPixel As Integer
    bmBits As Long
End Type

Public m_memBits() As Byte
Public m_memBitmapInfo() As Byte
Public m_bih As BITMAPINFOHEADER
Public m_bfh As BITMAPFILEHEADER
Public Sub AVIMovieRecord()

  If AVIRecording = False Then
    
    frmSMS.CommonDialog1.filename = ROM_Name$
    frmSMS.CommonDialog1.DialogTitle = "avi movie record"
    frmSMS.CommonDialog1.Filter = "avi movies (*.avi)|*.avi"
    Call frmSMS.CommonDialog1.ShowSave
    
    If frmSMS.CommonDialog1.filename = "" Then
      Exit Sub
    End If
    
    AVIFrames = 0
    
    frmSMS.mnuAVIRecord.Caption = "&stop avi movie" & vbTab & "shift+f7"
    
    Call AVIFileInit

    szOutputAVIFile = frmSMS.CommonDialog1.filename
    
    Call AVIFileOpen(pfile, szOutputAVIFile, OF_WRITE Or OF_CREATE, 0&)

    Set bmp = New cDIB

    Call SavePicture(exportbmp(frmSMS.picScreen), AVITemp)
    Call bmp.CreateFromFile(AVITemp)
    
    With strhdr '   Fill in the header for the video stream
      .fccType = mmioStringToFOURCC("vids", 0&) '// stream type video
      .fccHandler = 0& '// default AVI handler
      .dwScale = 1
      .dwRate = val(25) '// fps
      .dwSuggestedBufferSize = bmp.SizeImage '// size of one frame pixels
      Call SetRect(.rcFrame, 0, 0, bmp.Width, bmp.Height) '// rectangle for stream
    End With
    
    Call AVIFileCreateStream(pfile, ps, strhdr) 'And create the stream
    
    pOpts = VarPtr(Opts) 'get the compression options from the user'Careful! this API requires a pointer to a pointer to a UDT
    
    If AVISaveOptions(lhwnd, ICMF_CHOOSE_KEYFRAME Or ICMF_CHOOSE_DATARATE, 1, ps, pOpts) <> 1 Then 'returns TRUE if User presses OK, FALSE if Cancel, or error code/////In C TRUE = 1
      Call AVISaveOptionsFree(1, pOpts)
      GoTo 1
    End If

    Call AVIMakeCompressedStream(psCompressed, ps, Opts, 0&) 'make compressed stream
        
    With BI 'set format of stream according to the bitmap
      .biBitCount = bmp.BitCount
      .biClrImportant = bmp.ClrImportant
      .biClrUsed = bmp.ClrUsed
      .biCompression = bmp.Compression
      .biHeight = bmp.Height
      .biWidth = bmp.Width
      .biPlanes = bmp.Planes
      .biSize = bmp.SizeInfoHeader
      .biSizeImage = bmp.SizeImage
      .biXPelsPerMeter = bmp.XPPM
      .biYPelsPerMeter = bmp.YPPM
    End With
    
    Call AVIStreamSetFormat(psCompressed, 0, ByVal bmp.PointerToBitmapInfo, bmp.SizeBitmapInfo) 'set the format of the compressed stream
            
    AVIRecording = True
    
  Else
1:
    AVIRecording = False
    
    If (ps <> 0) Then Call AVIStreamClose(ps)
    If (psCompressed <> 0) Then Call AVIStreamClose(psCompressed)
    If (pfile <> 0) Then Call AVIFileClose(pfile)
    
    Call AVIFileExit
    
    Call Kill(App.Path & "\folders\temporary\*.*")
                
    frmSMS.mnuAVIRecord.Caption = "&record avi movie..." & vbTab & "shift+f7"
                
  End If
  
End Sub
Public Sub MoviePlay()

  If fileexists(App.Path & "\folders\movie states\" & ROM_Name$ & ".vm" & MovieSlot & "") <> True Then 'checks to see if movie exists
    Exit Sub
  End If

  frmSMS.mnuMoviePlay.Caption = "&stop" & vbTab & "f8" 'changes the menu

  MoviePlaying = True 'sets the boolean operator

  Open App.Path & "\folders\movie states\" & ROM_Name$ & ".vm" & StateSlot & "" For Binary As #3

  Get #3, , cartRam
  Get #3, , cartRom
  Get #3, , frame_two_rom
  'Get #3, , glMemAddrDiv256
  'Get #3, , Mul4000
  'Get #3, , number_of_pages
  'Get #3, , pages
  'Get #3, , ShiftRight
  'Get #3, , ShiftLeft
  Get #3, , SRAM
  Get #3, , VRAM
  Get #3, , CRAM
  Get #3, , vdpreg
  Get #3, , status
  Get #3, , first_byte
  Get #3, , command_byte
  Get #3, , location
  Get #3, , operation
  Get #3, , read_buffer
  Get #3, , counter
  Get #3, , lineint
  Get #3, , frameint
  'Get #3, , bg_priority
  'Get #3, , display
  Get #3, , regA
  Get #3, , regHL
  Get #3, , regB
  Get #3, , regC
  Get #3, , regDE
  Get #3, , regAF_
  Get #3, , regHL_
  Get #3, , regBC_
  Get #3, , regDE_
  Get #3, , regIX
  Get #3, , regIY
  Get #3, , regID
  Get #3, , fC
  Get #3, , fN
  Get #3, , fPV
  Get #3, , f3
  Get #3, , fH
  Get #3, , f5
  Get #3, , fZ
  Get #3, , fS
  Get #3, , intI
  Get #3, , intR
  Get #3, , intRTemp
  Get #3, , intIFF1
  Get #3, , intIFF2
  Get #3, , intIM
  Get #3, , halt
  Get #3, , regSP
  Get #3, , regPC
  'Get #3, , Parity
  Get #3, , irqsetLine

  'leave it open for movie playing

End Sub
Public Sub MoviePlayEnd()

  If EOF(3) Then Call MoviePlayStop 'checks to see if end of the movie

End Sub
Public Sub MoviePlayStop()

  If MoviePlaying = True Then 'checks to see if it's actually playing
    frmSMS.mnuMoviePlay.Caption = "&play" & vbTab & "f8" 'changes the menu caption accordingly
    MoviePlaying = False 'sets the boolean operator
    Close #3 'closes the file writing
    Call frmSMS.mnuReset_Click 'resets the cpu
  End If

End Sub
Public Sub MovieRecord()

  frmSMS.mnuMovieRecord.Caption = "&stop" & vbTab & "f7" 'changes menu caption accordingly

  MovieRecording = True 'sets boolean operator

  Open App.Path & "\folders\movie states\" & ROM_Name$ & ".vm" & MovieSlot & "" For Binary As #3 'opens movie file

  Put #3, , cartRam
  Put #3, , cartRom
  Put #3, , frame_two_rom
  'put #3, , glMemAddrDiv256
  'put #3, , Mul4000
  'Put #3, , number_of_pages
  'Put #3, , pages
  'put #3, , ShiftRight
  'put #3, , ShiftLeft
  Put #3, , SRAM
  Put #3, , VRAM
  Put #3, , CRAM
  Put #3, , vdpreg
  Put #3, , status
  Put #3, , first_byte
  Put #3, , command_byte
  Put #3, , location
  Put #3, , operation
  Put #3, , read_buffer
  Put #3, , counter
  Put #3, , lineint
  Put #3, , frameint
  'Put #3, , bg_priority
  'Put #3, , display
  Put #3, , regA
  Put #3, , regHL
  Put #3, , regB
  Put #3, , regC
  Put #3, , regDE
  Put #3, , regAF_
  Put #3, , regHL_
  Put #3, , regBC_
  Put #3, , regDE_
  Put #3, , regIX
  Put #3, , regIY
  Put #3, , regID
  Put #3, , fC
  Put #3, , fN
  Put #3, , fPV
  Put #3, , f3
  Put #3, , fH
  Put #3, , f5
  Put #3, , fZ
  Put #3, , fS
  Put #3, , intI
  Put #3, , intR
  Put #3, , intRTemp
  Put #3, , intIFF1
  Put #3, , intIFF2
  Put #3, , intIM
  Put #3, , halt
  Put #3, , regSP
  Put #3, , regPC
  'put #3, , Parity
  Put #3, , irqsetLine

  'keeps it open for movie writing

End Sub
Public Sub MovieRecordStop()

  If MovieRecording = True Then 'checks to see if actually recording
    frmSMS.mnuMovieRecord.Caption = "&record" & vbTab & "f7" 'changes menu caption accordingly
    MovieRecording = False 'sets boolean operator
    Close #3 'closes file that was being written
  End If

End Sub
